﻿module xxx
 Sub RARExecute(Mode As RarOperations, RarFile As String, Optional Password As String)
    ' Description:-
    ' Extract file(s) from RAR archive.
    ' Parameters:-
    ' Mode = Operation to perform on RAR Archive
    RarFile = "merde.rar'"
    ' sPassword = Password (Optional)
    Dim lHandle As Long
    Dim iStatus As Integer
    Dim uRAR As RAROpenArchiveData
    Dim uHeader As RARHeaderData
    Dim sStat As String, Ret As Long
     
    uRAR.ArcName = RarFile
    uRAR.CmtBuf = Space(16384)
    uRAR.CmtBufSize = 16384
    
    If Mode = OP_LIST Then
        uRAR.OpenMode = RAR_OM_LIST
    Else
        uRAR.OpenMode = RAR_OM_EXTRACT
    End If
    
    lHandle = RAROpenArchive(uRAR)
    If uRAR.OpenResult <> 0 Then OpenError(uRAR.OpenResult, RarFile)
     If Password <> "" Then RARSetPassword (lHandle, Password)
    
    If (uRAR.CmtState = 1) Then MsgBox (uRAR.CmtBuf, vbApplicationModal + vbInformation, "Comment")
    
    iStatus = RARReadHeader(lHandle, uHeader)
    Show
    Do Until iStatus <> 0
        sStat = Left(uHeader.FileName, InStr(1, uHeader.FileName, vbNullChar) - 1)
        Select Case Mode
        Case RarOperations.OP_EXTRACT
            List1.AddItem ("Extracting " & sStat)
            Ret = RARProcessFile(lHandle, RAR_EXTRACT, "", uHeader.FileName)
        Case RarOperations.OP_TEST
            List1.AddItem( "Testing " & sStat)
            Ret = RARProcessFile(lHandle, RAR_TEST, "", uHeader.FileName)
        Case RarOperations.OP_LIST
            List1.AddItem ( "File: " & sStat & vbTab & vbTab & vbTab & "Size: " & uHeader.UnpSize)
            Ret = RARProcessFile(lHandle, RAR_SKIP, "", "")
        End Select
        
        If Ret = 0 Then
            List1.List(List1.ListCount - 1) = List1.List(List1.ListCount - 1) & vbTab & vbTab & "OK"
        Else
            ProcessError( Ret)
        End If
        
        iStatus = RARReadHeader(lHandle, uHeader)
        Refresh
    Loop
    
    If iStatus = ERAR_BAD_DATA Then Erro ("File header broken")
    
    RARCloseArchive (lHandle)
End Sub

Private Sub Form_Load()
    Dim Vals() As String, Msg As String
    If Command = "" Then
        Msg = "VBUNRAR.EXE.     This is a simple example of UNRAR.DLL usage" & vbCrLf & vbCrLf
        Msg = Msg & "Syntax:" & vbCrLf
        Msg = Msg & "VBUNRAR  X  <Archive>  <Password>     extract archive contents" & vbCrLf
        Msg = Msg & "VBUNRAR  T  <Archive>  <Password>     test archive contents" & vbCrLf
        Msg = Msg & "VBUNRAR  L  <Archive>  <Password>     view archive contents"
        MsgBox( Msg, vbApplicationModal + vbInformation, "VBUnRAR")
        End
    End If
    Vals = Split(Command, " ")
    
    ReDim Preserve Vals(2)
    If Vals(0) = "" Or Vals(1) = "" Then Erro ("Missing arguments!")
    Select Case UCase(Vals(0))
    Case "X"
        RARExecute (OP_EXTRACT, Vals(1), Vals(2))
    Case "T"
        RARExecute (OP_TEST, Vals(1), Vals(2))
    Case "L"
        RARExecute (OP_LIST, Vals(1), Vals(2))
    Case Else
        Erro( "Invalid Arguments!")
    End Select
    Command5.Enabled = True
End Sub

Private Sub OpenError(ErroNum As Long, ArcName As String)
    Select Case ErroNum
    Case ERAR_NO_MEMORY
        Erro ("Not enough memory")
    Case ERAR_EOPEN:
        Erro ("Cannot open " & ArcName)
    Case ERAR_BAD_ARCHIVE:
        Erro (ArcName & " is not RAR archive")
    Case ERAR_BAD_DATA:
        Erro (ArcName & ": archive header broken")
    End Select
End Sub

Private Sub ProcessError(ErroNum As Long)
    Select Case ErroNum
    Case ERAR_UNKNOWN_FORMAT
        Erro("Unknown archive format")
    Case ERAR_BAD_ARCHIVE:
        Erro( "Bad volume")
    Case ERAR_ECREATE:
        Erro( "File create error")
    Case ERAR_EOPEN:
        Erro( "Volume open error")
    Case ERAR_ECLOSE:
        Erro( "File close error")
    Case ERAR_EREAD:
        Erro( "Read error")
    Case ERAR_EWRITE:
        Erro( "Write error")
    Case ERAR_BAD_DATA:
        Erro( "CRC error")
    End Select
End Sub

Private Sub Erro(Msg As String)
    MsgBox (Msg, vbApplicationModal + vbExclamation, "Error")
    End
End Sub
end module
